home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / BBSDEF.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  7KB  |  232 lines
  1. UNIT BBSDef;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ BBSDEF.PAS - BBS definition reader/handler    Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, PoPTypes, Dos;
  16.  
  17. CONST
  18.   bdName         =  1;
  19.   bdTask         =  2;
  20.   bdFilePath     =  3;
  21.   bdListPath     =  4;
  22.   bdAreaTag      =  5;
  23. TYPE
  24.   TFieldType=(ftAsciiZ,ftByte,ftShort,ftChar,ftWord,ftInt,ftLong,ftStr);
  25.   PFileStruct=^TFileStruct;
  26.   TField=RECORD
  27.     Name      : S20;
  28.     Typ       : TFieldType;
  29.     Len       : WORD;
  30.     Special   : BYTE;
  31.   END;
  32.   TFileStruct=RECORD
  33.     NumFields : BYTE;
  34.     Tasks     : BOOLEAN;
  35.     FDBPath,
  36.     Name      : PathStr;
  37.     Fields    : ARRAY[0..0] OF TField;
  38.   END;
  39.  
  40. PROCEDURE DisposeFileStruct(VAR u:PFileStruct);
  41. PROCEDURE GetFileStruct(VAR fs:PFileStruct; CONST FName:S20);
  42. FUNCTION  FieldLen(CONST F:TField):WORD;
  43. FUNCTION  RecLen(Fs:PFileStruct):WORD;
  44. PROCEDURE GetField(F:PFileStruct; FieldNum:BYTE; Buf:POINTER; VAR Adr);
  45. FUNCTION  FindField(F:PFileStruct; Fl:BYTE):BYTE;
  46. FUNCTION  GetFieldText(f:PFileStruct; Num:BYTE; Buf:POINTER):STRING;
  47.  
  48. IMPLEMENTATION
  49.  
  50. USES OpString, OpRoot,
  51.      StrUtil, OproUtil, Globals, Util;
  52.  
  53. FUNCTION  GetFieldText(f:PFileStruct; Num:BYTE; Buf:POINTER):STRING;
  54. VAR
  55.   s,ss:STRING;
  56.   BVal:BYTE ABSOLUTE s;
  57.   Wval:WORD ABSOLUTE s;
  58.   LVal:LONGINT ABSOLUTE s;
  59. BEGIN
  60.   s:='';
  61.   IF Num>0 THEN
  62.   BEGIN
  63.     GetField(f,Num,Buf,s);
  64.     CASE f^.Fields[Num].Typ OF
  65.       ftByte   : s:=Long2Str(BVal);
  66.       ftShort  : s:=Long2Str(ShortInt(BVal));
  67.       ftChar   : s:=s[0];
  68.       ftWord   : s:=Long2Str(Wval);
  69.       ftInt    : s:=Long2Str(Integer(WVal));
  70.       ftLong   : s:=Long2Str(LVal);
  71.       ftStr    : ;
  72.       ftAsciiZ : BEGIN
  73.                    ss:=AsciiZ2Str(s,f^.Fields[Num].Len);
  74.                    s:=ss;
  75.                  END;
  76.     END;
  77.   END;
  78.   GetFieldText:=s;
  79. END;
  80.  
  81. FUNCTION  FindField(F:PFileStruct; Fl:BYTE):BYTE;
  82. VAR
  83.   i:BYTE;
  84. BEGIN
  85.   FindField:=0;
  86.   WITH F^ DO
  87.   BEGIN
  88.     FOR i:=1 TO NumFields DO
  89.       IF Fl=Fields[i].Special THEN
  90.       BEGIN
  91.         FindField:=i;
  92.         Break;
  93.       END;
  94.   END;
  95. END;
  96.  
  97. PROCEDURE GetField(F:PFileStruct; FieldNum:BYTE; Buf:POINTER; VAR Adr);
  98. VAR
  99.   offset:WORD;
  100.   i:BYTE;
  101. BEGIN
  102.   offset:=0;
  103.   FOR i:=1 TO FieldNum-1 DO
  104.     INC(OffSet,FieldLen(f^.Fields[i]));
  105.   MOVE(BT0(Buf^)[offset],Adr,FieldLen(f^.Fields[FieldNum]));
  106. END;
  107.  
  108. FUNCTION RecLen(Fs:PFileStruct):WORD;
  109. VAR
  110.   l:WORD;
  111.   i:BYTE;
  112. BEGIN
  113.   l:=0;
  114.   FOR i:=1 TO Fs^.NumFields DO
  115.     INC(l,FieldLen(Fs^.Fields[i]));
  116.   RecLen:=l;
  117. END;
  118.  
  119. FUNCTION FieldLen(CONST F:TField):WORD;
  120. BEGIN
  121.   CASE f.Typ OF
  122.     ftByte,ftShort,ftChar : FieldLen:=1;
  123.     ftInt,ftWord          : FieldLen:=2;
  124.     ftLong                : FieldLen:=4;
  125.     ftStr                 : FieldLen:=f.Len+1;
  126.     ftAsciiZ              : FieldLen:=f.Len;
  127.   END;
  128. END;
  129.  
  130. PROCEDURE DisposeFileStruct(VAR u:PFileStruct);
  131. VAR
  132.   i: Word;
  133. BEGIN
  134.   IF u<>NIL THEN
  135.   BEGIN
  136.     i:=SizeOf(TFileStruct)+(SizeOf(TField)*u^.NumFields);
  137.     FreeMemCheck(u,i);
  138.   END;
  139. END;
  140.  
  141. PROCEDURE GetFileStruct(VAR fs:PFileStruct; CONST FName:S20);
  142. VAR
  143.   i:INTEGER;
  144.   f:TBufTextFile;
  145.   s,ss:STRING;
  146.   Flag:BOOLEAN;
  147.   Tmp:TFileStruct;
  148. BEGIN
  149.   fs:=NIL;
  150.   IF Cfg.BBS.DefFile<>'' THEN
  151.     IF f.Init(StartPath+Cfg.BBS.DefFile+'.PBD',SOpenRead,1024) THEN
  152.     BEGIN
  153.       Flag:=FALSE;
  154.       WHILE (NOT Flag) AND (NOT f.EoF) DO
  155.       BEGIN
  156.         f.ReadLn(s);
  157.         s:=Trim(s);
  158.         ss:=NextWord(' ',s);
  159.         IF StUpCase(ss)='#'+FName THEN
  160.         BEGIN
  161.           Tmp.FDBPath:='';
  162.           Tmp.Tasks:=FALSE;
  163.           Tmp.Name:=NextWord(' ',s);
  164.           Str2Int(NextWord(' ',s),i);
  165.           Tmp.NumFields:=i;
  166.           ss:=StUpCase(NextWord(' ',s));
  167.           WHILE ss<>'' DO
  168.           BEGIN
  169.             IF ss='TASK' THEN Tmp.Tasks:=TRUE ELSE
  170.               IF COPY(ss,1,4)='FDB=' THEN Tmp.FDBPath:=COPY(ss,5,80);
  171.             ss:=StUpCase(NextWord(' ',s));
  172.           END;
  173.           GetMem(fs,SizeOf(TFileStruct)+(SizeOf(TField)*Tmp.NumFields));
  174.           fs^.Name:=Tmp.Name;
  175.           fs^.NumFields:=0;
  176.           fs^.Tasks:=Tmp.Tasks;
  177.           fs^.FDBPath:=Tmp.FDBPath;
  178.           Flag:=FALSE;
  179.           WHILE (NOT Flag) AND (NOT f.Eof) DO
  180.           BEGIN
  181.             f.ReadLn(s);
  182.             s:=Trim(s);
  183.             IF StUpCase(s)='#END' THEN Flag:=TRUE ELSE
  184.             BEGIN
  185.               INC(fs^.NumFields);
  186.               WITH fs^.Fields[fs^.NumFields] DO
  187.               BEGIN
  188.                 Len:=0;
  189.                 Name:=NextWord(' ',s);
  190.                 s:=Trim(s);
  191.                 Replace(Name,'_',' ',0);
  192.                 ss:=StUpCase(NextWord(' ',s));
  193.  
  194.                 IF ss='BYTE' THEN Typ:=ftByte ELSE
  195.                   IF ss='CHAR' THEN Typ:=ftChar ELSE
  196.                     IF ss='SHORT' THEN Typ:=ftShort ELSE
  197.                       IF ss='WORD' THEN Typ:=ftWord ELSE
  198.                         IF ss='INTEGER' THEN Typ:=ftInt ELSE
  199.                           IF ss='LONG' THEN Typ:=ftLong ELSE
  200.                             IF ss='ASCIIZ' THEN
  201.                             BEGIN
  202.                               Typ:=ftAsciiZ;
  203.                               ss:=NextWord(' ',s);
  204.                               Str2Int(ss,i);
  205.                               Len:=i;
  206.                             END
  207.                             ELSE
  208.                               IF ss='STRING' THEN
  209.                               BEGIN
  210.                                 Typ:=ftStr;
  211.                                 ss:=NextWord(' ',s);
  212.                                 Str2Int(ss,i);
  213.                                 Len:=i;
  214.                               END;
  215.                 s:=StUpCase(Trim(s));
  216.                 IF s='NAME' THEN Special:=bdName ELSE
  217.                   IF s='TASK' THEN Special:=bdTask ELSE
  218.                     IF s='FILEPATH' THEN Special:=bdFilePath ELSE
  219.                       IF s='LISTPATH' THEN Special:=bdListPath ELSE
  220.                         IF s='AREATAG' THEN Special:=bdAreaTag ELSE
  221.                           Special:=0;
  222.               END;
  223.             END;
  224.           END;
  225.         END;
  226.       END;
  227.       f.Done;
  228.     END;
  229. END;
  230.  
  231. END.
  232.